home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Internet / WWW / Perl_WWW_Utilities / MHonArc / lib / base64.pl next >
Encoding:
Perl Script  |  1996-04-16  |  6.2 KB  |  217 lines

  1. #!/usr/bin/perl
  2. # base64.pl -- A perl package to handle MIME-style BASE64 encoding
  3. # A. P. Barrett <barrett@ee.und.ac.za>, October 1993
  4. # $Revision: 1.4 $$Date: 1994/08/11 16:08:51 $
  5. #
  6. # Modified March 21, 1996 by ehood@convex.com
  7. #    -> Changes to base64'uudecode to strip out any begin/end
  8. #       lines from imput string.
  9. #
  10. # Modified April 16, 1996 by ehood@convex.com
  11. #    -> Change in base64'b64decode to use substr() to extract
  12. #       data for decoding instead of a regular expression.
  13. #       Results in a huge increase in execution time under Perl 4.
  14. #       Perl 5 regular expression capability could be used to
  15. #       give comperable performance, but would break Perl 4
  16. #       compatibility.  Also, the substr() algorithm appears
  17. #       to edge out the perl 5 method.
  18. #
  19. #       Other functions have not been changed to use substr(), but
  20. #       may benefit from it.
  21.  
  22. package base64;
  23.  
  24. # Synopsis:
  25. #       require 'base64.pl';
  26. #
  27. #       $uuencode_string = &base64'b64touu($base64_string);
  28. #       $binary_string = &base64'b64decode($base64_string);
  29. #       $base64_string = &base64'uutob64($uuencode_string);
  30. #       $base64_string = &base64'b64encode($binary_string);
  31. #       $uuencode_string = &base64'uuencode($binary_string);
  32. #       $binary_string = &base64'uudecode($uuencode_string);
  33. #
  34. #       uuencode and base64 input strings may contain multiple lines,
  35. #       but may not contain any headers or trailers.  (For uuencode,
  36. #       remove the begin and end lines, and for base64, remove the MIME
  37. #       headers and boundaries.)
  38. #
  39. #       uuencode and base64 output strings will be contain multiple
  40. #       lines if appropriate, but will not contain any headers or
  41. #       trailers.  (For uuencode, add the "begin" line and the
  42. #       " \nend\n" afterwards, and for base64, add any MIME stuff
  43. #       afterwards.)
  44.  
  45. ####################
  46.  
  47. $base64_alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
  48.                    'abcdefghijklmnopqrstuvwxyz'.
  49.                    '0123456789+/';
  50. $base64_pad = '=';
  51.  
  52. $uuencode_alphabet = q|`!"#$%&'()*+,-./0123456789:;<=>?|.
  53.                       '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_'; # double that '\\'!
  54. $uuencode_pad = '`';
  55.  
  56. # Build some strings for use in tr/// commands.
  57. # Some uuencodes use " " and some use "`", so we handle both.
  58. # We also need to protect backslashes and other special characters.
  59. $tr_uuencode = " ".$uuencode_alphabet;
  60. $tr_uuencode =~ s/(\W)/\\$1/g;
  61. $tr_base64 = "A".$base64_alphabet;
  62. $tr_base64 =~ s/(\W)/\\$1/g;
  63.  
  64. sub b64touu
  65. {
  66.     local ($_) = @_;
  67.     local ($result);
  68.     
  69.     # zap bad characters and translate others to uuencode alphabet
  70.     eval qq{
  71.     tr|$tr_base64||cd;
  72.     tr|$tr_base64|$tr_uuencode|;
  73.     };
  74.  
  75.     # break into lines of 60 encoded chars, prepending "M" for uuencode
  76.     while (s/^(.{60})//) {
  77.     $result .= "M" . $& . "\n";
  78.     }
  79.  
  80.     # any leftover chars go onto a shorter line
  81.     # with padding to the next multiple of 4 chars
  82.     if ($_ ne "") {
  83.     $result .= substr($uuencode_alphabet, length($_)*3/4, 1)
  84.            . $_
  85.            . ($uuencode_pad x ((60 - length($_)) % 4)) . "\n";
  86.     }
  87.  
  88.     # return result
  89.     $result;
  90. }
  91.  
  92. sub b64decode
  93. {
  94.     # substr() usage added by ehood, 1996/04/16
  95.  
  96.     local ($str) = shift;
  97.     local ($result, $tmp, $offset, $len) = ('','', 0, 0);
  98.     
  99.     # zap bad characters and translate others to uuencode alphabet
  100.     eval qq{
  101.     \$str =~ tr|$tr_base64||cd;
  102.     \$str =~ tr|$tr_base64|$tr_uuencode|;
  103.     };
  104.  
  105.     # break into lines of 60 encoded chars, prepending "M" for uuencode,
  106.     # and then using perl's builtin uudecoder to convert to binary.
  107.     #
  108.     $len = length($str);            # store length
  109.     while ($offset+60 <= $len) {        # loop until < 60 chars left
  110.     $tmp = substr($str, $offset, 60);    # grap 60 char block
  111.     $offset += 60;                # increment offset
  112.     $result .= unpack("u", "M" . $tmp);    # decode block
  113.     }
  114.     # also decode any leftover chars
  115.     if ($offset < $len) {
  116.     $tmp = substr($str, $offset, $len-$offset);
  117.     $result .= unpack("u",
  118.             substr($uuencode_alphabet, length($tmp)*3/4, 1) . $tmp);
  119.     }
  120.  
  121.     # return result
  122.     $result;
  123. }
  124.  
  125. sub uutob64
  126. {
  127.     local ($_) = @_;
  128.     local ($result);
  129.     
  130.     # This is the most difficult, because some perverse uuencoder
  131.     # might have made lines that do not describe multiples of 3 bytes.
  132.     # I don't see any better method than uudecoding to binary and then
  133.     # b64encoding the binary.
  134.  
  135.     &b64encode(&uudecode); # implicitly pass @_ to &uudecode
  136. }
  137.  
  138. sub b64encode
  139. {
  140.     local ($_) = @_;
  141.     local ($chunk);
  142.     local ($result);
  143.     
  144.     # break into chunks of 45 input chars, use perl's builtin
  145.     # uuencoder to convert each chunk to uuencode format,
  146.     # then kill the leading "M", translate to the base64 alphabet,
  147.     # and finally append a newline.
  148.     while (s/^((.|\n){45})//) {
  149.     #warn "in:$&:\n";
  150.     $chunk = substr(pack("u", $&), $[+1, 60);
  151.     #warn "packed    :$chunk:\n";
  152.     eval qq{
  153.         \$chunk =~ tr|$tr_uuencode|$tr_base64|;
  154.     };
  155.     #warn "translated:$chunk:\n";
  156.     $result .= $chunk . "\n";
  157.     }
  158.  
  159.     # any leftover chars go onto a shorter line
  160.     # with uuencode padding converted to base64 padding
  161.     if ($_ ne "") {
  162.     #warn "length ".length($_)." \$_:$_:\n";
  163.     #warn "enclen ", int((length($_)+2)/3)*4 - (45-length($_))%3, "\n";
  164.     $chunk = substr(pack("u", $_), $[+1,
  165.             int((length($_)+2)/3)*4 - (45-length($_))%3);
  166.     #warn "chunk:$chunk:\n";
  167.     eval qq{
  168.         \$chunk =~ tr|$tr_uuencode|$tr_base64|;
  169.     };
  170.     #warn "translated:$chunk:\n";
  171.     $result .= $chunk . ($base64_pad x ((60 - length($chunk)) % 4)) . "\n";
  172.     }
  173.  
  174.     # return result
  175.     $result;
  176. }
  177.  
  178. sub uuencode
  179. {
  180.     local ($_) = @_;
  181.     local ($result);
  182.     
  183.     # break into chunks of 45 input chars, and use perl's builtin
  184.     # uuencoder to convert each chunk to uuencode format.
  185.     # (newline is added by builtin uuencoder.)
  186.     while (s/^((.|\n){45})//) {
  187.     $result .= pack("u", $&);
  188.     }
  189.  
  190.     # any leftover chars go onto a shorter line
  191.     # with padding to the next multiple of 4 chars
  192.     if ($_ ne "") {
  193.     $result .= pack("u", $_);
  194.     }
  195.  
  196.     # return result
  197.     $result;
  198. }
  199.  
  200. sub uudecode
  201. {
  202.     local ($_) = @_;
  203.     local ($result);
  204.     
  205.     # strip out begin/end lines        (ehood, 1996/03/21)
  206.     s/^\s*begin[^\n]+\n//;
  207.     s/\nend\s*$//;
  208.  
  209.     # use perl's builtin uudecoder to convert each line
  210.     while (s/^([^\n]+\n?)//) {
  211.     $result .= unpack("u", $&);
  212.     }
  213.  
  214.     # return result
  215.     $result;
  216. }
  217.